home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
fpkpas92.zip
/
SRCRTL.ZIP
/
RTL
/
STRINGS.PP
< prev
Wrap
Text File
|
1997-07-01
|
15KB
|
575 lines
{****************************************************************************
FPKPascal Runtime-Library
Copyright (c) 1993,94 by Florian Klämpfl
****************************************************************************}
{
History:
1.5.1994: Version 0.9
Unit ist komplett implementiert (noch nicht getestet)
20.3.1995: Version 0.91
strmove korriert, für system.move müssen Pointer
dereferenziert werden
24.12.1995: Version 0.92
strcomp war fehlerhaft; korrigiert
dito strlcomp
}
unit strings;
{ Behandlung nullterminierter Strings }
{ für alle Betriebssysteme }
interface
{$E-}
{ stellt die Länge des Strings fest }
function strlen(p : pchar) : longint;
{ konvertiert einen Pascalstring in einen nullterminierten String }
function strpcopy(d : pchar;const s : string) : pchar;
{ wandelt einen nullterminierten String in einen Pascalstring um }
function strpas(p : pchar) : string;
{ kopiert source nach dest und liefert dest zurück }
function strcopy(dest,source : pchar) : pchar;
{ kopiert source nach dest und liefert dest zurück, wobei max. }
{ maxlen Zeichen kopiert werden }
function strlcopy(dest,source : pchar;maxlen : longint) : pchar;
{ kopiert source nach dest und liefert einen Zeiger auf das }
{ abschließende #0-Zeichen }
function strecopy(dest,source : pchar) : pchar;
{ liefert einen Zeiger auf das abschließende #0-Zeichen von p }
function strend(p : pchar) : pchar;
{ hängt source an dest an und gibt dest zurück }
function strcat(dest,source : pchar) : pchar;
{ vergleicht str1 und str2, liefert einen Wert <0 wenn }
{ str1<str2; 0 wenn str1=str2 und einen Wert >0 wenn str1>str2 }
function strcomp(str1,str2 : pchar) : longint;
{ wie strcomp, es werden jedoch maximal l Zeichen verglichen }
function strlcomp(str1,str2 : pchar;l : longint) : longint;
{ wie strcomp jedoch ohne Beachtung der Groß- und Klein- }
{ schreibung }
function stricomp(str1,str2 : pchar) : longint;
{ kopiert l Zeichen von source nach dest }
{ und gibt dest zurück }
function strmove(dest,source : pchar;l : longint) : pchar;
{ hängt source an dest an, wobei dest maximal l Zeichen }
{ lang wird }
function strlcat(dest,source : pchar;l : longint) : pchar;
{ gibt einen Zeiger auf das erste Auftreten von c zurück, }
{ ansonsten nil }
function strscan(p : pchar;c : char) : pchar;
{ gibt einen Zeiger auf das letzte Auftreten von c zurück, }
{ ansonsten nil }
function strrscan(p : pchar;c : char) : pchar;
{ wandelt p in Kleinbuchstaben um und gibt p zurück }
function strlower(p : pchar) : pchar;
{ wandelt p in Großbuchstaben um und gibt p zurück }
function strupper(p : pchar) : pchar;
{ wie stricomp, jedoch maximal l Zeichen }
function strlicomp(str1,str2 : pchar;l : longint) : longint;
{ liefert einen Zeiger auf das erste Auftreten von str2 in }
{ str2 ansonsten wird nil zurück gegeben }
function strpos(str1,str2 : pchar) : pchar;
{ legt eine Kopie von p auf dem Heap an und gibt einen Zeiger }
{ darauf zurück }
function strnew(p : pchar) : pchar;
{ löscht einen Zeiger vom Heap }
procedure strdispose(p : pchar);
implementation
function strcopy(dest,source : pchar) : pchar;
begin
asm
cld
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
xorb %al,%al
repne
scasb
not %ecx
movl 8(%ebp),%edi
movl 12(%ebp),%esi
movl %ecx,%eax
shrl $2,%ecx
rep
movsl
movl %eax,%ecx
andl $3,%ecx
rep
movsb
movl 8(%ebp),%eax
leave
ret $8
end;
end;
function strecopy(dest,source : pchar) : pchar;
begin
asm
cld
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
xorb %al,%al
repne
scasb
not %ecx
movl 8(%ebp),%edi
movl 12(%ebp),%esi
movl %ecx,%eax
shrl $2,%ecx
rep
movsl
movl %eax,%ecx
andl $3,%ecx
rep
movsb
movl 8(%ebp),%eax
decl %edi
movl %edi,%eax
leave
ret $8
end ['EAX','ESI','EDI'];
end;
function strlcopy(dest,source : pchar;maxlen : longint) : pchar;
begin
asm
movl 8(%ebp),%edi
movl 12(%ebp),%esi
movl 16(%ebp),%ecx
cld
LSTRLCOPY1:
lodsb
stosb
decl %ecx // max. Anzahl erniedrigen
jz LSTRLCOPY2 // 0 erreicht, dann Ende
orb %al,%al
jnz LSTRLCOPY1
movl 8(%ebp),%eax
leave
ret $12
LSTRLCOPY2:
xorb %al,%al // falls abgeschnitten wurde, noch
stosb // ein #0 speichern
movl 8(%ebp),%eax
leave
ret $12
end ['EAX','ECX','ESI','EDI'];
end;
function strlen(p : pchar) : longint;
begin
asm
cld
movl 8(%ebp),%edi
movl $0xffffffff,%ecx
xorb %al,%al
repne
scasb
movl $0xfffffffe,%eax
subl %ecx,%eax
leave
ret $4
end ['EDI','ECX','EAX'];
end;
function strend(p : pchar) : pchar;
begin
asm
cld
movl 8(%ebp),%edi
movl $0xffffffff,%ecx
xorb %al,%al
repne
scasb
movl %edi,%eax
decl %eax
leave
ret $4
end ['EDI','ECX','EAX'];
end;
function strpcopy(d : pchar;const s : string) : pchar;
begin
asm
pushl %esi // ESI wird nicht automatisch gerettet
cld
movl 8(%ebp),%edi // Zieladresse laden
movl 12(%ebp),%esi // Quelladresse laden
movl %edi,%ebx // Rückgabewert speichern
lodsb // Längenbyte laden und nach ECX
movzbl %al,%ecx
rep
movsb
xorb %al,%al // Nullbyte speichern
stosb
movl %ebx,%eax // Rückgabeadresse nach EAX
popl %esi
leave // ... und fertig
ret $8
end ['EDI','ESI','EBX','EAX','ECX'];
end;
function strpas(p : pchar) : string;
begin
asm
cld
movl 12(%ebp),%edi
movl %edi,%esi // Quelle
movl $0xffffffff,%ecx // nach Ende suchen
xorb %al,%al
repne
scasb
notl %ecx
decl %ecx
movl 8(%ebp),%edi // Ziel neu laden
movb %cl,%al
stosb
rep
movsb
end ['ECX','EAX','ESI','EDI'];
end;
function strcat(dest,source : pchar) : pchar;
begin
strcat:=strcopy(strend(dest),source);
end;
function strlcat(dest,source : pchar;l : longint) : pchar;
var
destend : pchar;
begin
destend:=strend(dest);
l:=l-(destend-dest);
strlcat:=strlcopy(destend,source,l);
end;
function strcomp(str1,str2 : pchar) : longint;
begin
asm
// Nullbyte im ersten String suchen
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorl %eax,%eax
repne
scasb
not %ecx
movl 12(%ebp),%edi
movl 8(%ebp),%esi
repe
cmpsb
movb -1(%esi),%al
movzbl -1(%edi),%ecx
subl %ecx,%eax
leave
ret $8
end ['EAX','ECX','ESI','EDI'];
end;
function strlcomp(str1,str2 : pchar;l : longint) : longint;
begin
asm
// Nullbyte im ersten String suchen
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorl %eax,%eax
repne
scasb
not %ecx
cmpl 16(%ebp),%ecx
jl LSTRLCOMP1
movl 16(%ebp),%ecx
LSTRLCOMP1:
movl 12(%ebp),%edi
movl 8(%ebp),%esi
repe
cmpsb
movb -1(%esi),%al
movzbl -1(%edi),%ecx
subl %ecx,%eax
leave
ret $12
end ['EAX','ECX','ESI','EDI'];
end;
function stricomp(str1,str2 : pchar) : longint;
begin
asm
// Nullbyte im ersten String suchen
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorl %eax,%eax
repne
scasb
not %ecx
movl 12(%ebp),%edi
movl 8(%ebp),%esi
LSTRICOMP2:
repe
cmpsb
jz LSTRICOMP3 // falls Ende erreicht dann herausspringen
movb (%esi),%al
movzbl (%edi),%ebx
cmpb $97,%al
jb LSTRICOMP1
cmpb $122,%al
ja LSTRICOMP1
subb $0x20,%al
LSTRICOMP1:
cmpb $97,%bl
jb LSTRICOMP4
cmpb $122,%bl
ja LSTRICOMP4
subb $0x20,%bl
LSTRICOMP4:
subl %ebx,%eax
jz LSTRICOMP2 // falls immer noch gleich nochmals
// vergleichen
LSTRICOMP3:
leave
ret $8
end ['EAX','ECX','ESI','EDI'];
end;
function strlicomp(str1,str2 : pchar;l : longint) : longint;
begin
asm
// Nullbyte im ersten String suchen
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorl %eax,%eax
repne
scasb
not %ecx
cmpl 16(%ebp),%ecx
jl LSTRLICOMP5
movl 16(%ebp),%ecx
LSTRLICOMP5:
movl 12(%ebp),%edi
movl 8(%ebp),%esi
LSTRLICOMP2:
repe
cmpsb
jz LSTRLICOMP3 // falls Ende erreicht dann herausspringen
movb (%esi),%al
movzbl (%edi),%ebx
cmpb $97,%al
jb LSTRLICOMP1
cmpb $122,%al
ja LSTRLICOMP1
subb $0x20,%al
LSTRLICOMP1:
cmpb $97,%bl
jb LSTRLICOMP4
cmpb $122,%bl
ja LSTRLICOMP4
subb $0x20,%bl
LSTRLICOMP4:
subl %ebx,%eax
jz LSTRLICOMP2 // falls immer noch gleich nochmals
// vergleichen
LSTRLICOMP3:
leave
ret $12
end ['EAX','ECX','ESI','EDI'];
end;
function strmove(dest,source : pchar;l : longint) : pchar;
begin
move(source^,dest^,l);
strmove:=dest;
end;
function strscan(p : pchar;c : char) : pchar;
begin
asm
movl 8(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorb %al,%al
repne
scasb
not %ecx
movb 12(%ebp),%al
movl 8(%ebp),%edi
repne
scasb
movl $0,%eax // EAX löschen, wenn bis Ende verglichen
// dann nil zurückgeben
jnz LSTRSCAN
movl %edi,%eax // sonst den um 1 erniedrigten Wert von
// EDI nach EAX
decl %eax
LSTRSCAN:
leave
ret $6
end;
end;
function strrscan(p : pchar;c : char) : pchar;
begin
asm
movl 8(%ebp),%edi
movl $0xffffffff,%ecx
cld
xorb %al,%al
repne
scasb
not %ecx
movb 12(%ebp),%al
movl 8(%ebp),%edi
addl %ecx,%edi
decl %edi
std
repne
scasb
movl $0,%eax // EAX löschen, wenn bis Ende verglichen
// dann nil zurückgeben
jnz LSTRSCAN
movl %edi,%eax // sonst den um 1 erhöhten Wert von
// EDI nach EAX
incl %eax
LSTRRSCAN:
leave
ret $6
end;
end;
function strupper(p : pchar) : pchar;
begin
asm
movl 8(%ebp),%esi
movl %esi,%edi
LSTRUPPER1:
lodsb
cmpb $97,%al
jb LSTRUPPER3
cmpb $122,%al
ja LSTRUPPER3
subb $0x20,%al
LSTRUPPER3:
stosb
orb %al,%al
jnz LSTRUPPER1
movl 8(%ebp),%eax
leave
ret $4
end;
end;
function strlower(p : pchar) : pchar;
begin
asm
movl 8(%ebp),%esi
movl %esi,%edi
LSTRLOWER1:
lodsb
cmpb $65,%al
jb LSTRLOWER3
cmpb $90,%al
ja LSTRLOWER3
addb $0x20,%al
LSTRLOWER3:
stosb
orb %al,%al
jnz LSTRLOWER1
movl 8(%ebp),%eax
leave
ret $4
end;
end;
function strpos(str1,str2 : pchar) : pchar;
var
p : pchar;
lstr2 : longint;
begin
strpos:=nil;
p:=strscan(str1,str2^);
if p=nil then
exit;
lstr2:=strlen(str2);
while p<>nil do
begin
if strlcomp(p,str2,lstr2)=0 then
begin
strpos:=p;
exit;
end;
inc(longint(p));
p:=strscan(p,str2^);
end;
end;
procedure strdispose(p : pchar);
begin
if p<>nil then
freemem(p,strlen(p)+1);
end;
function strnew(p : pchar) : pchar;
var
len : longint;
begin
strnew:=nil;
if (p=nil) or (p^=#0) then
exit;
len:=strlen(p)+1;
getmem(strnew,len);
if strnew<>nil then
strmove(strnew,p,len);
end;
end.